home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog3.arj / UWINDOW.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  14.1 KB  |  506 lines
  1. {******************************************************************}
  2. {                                                                  }
  3. {     Mancala                                                      }
  4. {     Turbo Pascal for Windows                                     }
  5. {     Copyright (c) 1991 by Swan Software. All rights reserved.    }
  6. {                                                                  }
  7. {******************************************************************}
  8.  
  9. { uwindow.pas -- Main window object for Mancala }
  10.  
  11. unit UWindow;
  12.  
  13. interface
  14.  
  15. uses WinTypes, WinProcs, WObjects, Strings,
  16.      UGlobals, UGraphics, UPlay, UMove, UOptions, Idents;
  17.  
  18. type
  19.  
  20.   PMancalaWin = ^TMancalaWin;
  21.   TMancalaWin = object(TWindow)
  22.     BkPattern: HBrush;         { Window background--forced to white }
  23.     Help: Boolean;             { True to display help in WMCommand }
  24.     HelpFileName: PChar;       { Online help file name }
  25.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  26.     destructor Done; virtual;
  27.     procedure SetupWindow; virtual;
  28.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  29.     function GetClassName: PChar; virtual;
  30.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  31.     function CanClose: Boolean; virtual;
  32.     procedure MakeMoves;
  33.     procedure CMGameNew(var Msg: TMessage);
  34.       virtual cm_First + cm_GameNew;
  35.     procedure CMGameExit(var Msg: TMessage);
  36.       virtual cm_First + cm_GameExit;
  37.     procedure CMEditOptions(var Msg: TMessage);
  38.       virtual cm_First + cm_EditOptions;
  39.     procedure CMActionReplay(var Msg: TMessage);
  40.       virtual cm_First + cm_ActionReplay;
  41.     procedure CMActionPass(var Msg: TMessage);
  42.       virtual cm_First + cm_ActionPass;
  43.     procedure CMActionSwitch(var Msg: TMessage);
  44.       virtual cm_First + cm_ActionSwitch;
  45.     procedure CMHelpIndex(var Msg: TMessage);
  46.       virtual cm_First + cm_HelpIndex;
  47.     procedure CMHelpUsing(var Msg: TMessage);
  48.       virtual cm_First + cm_HelpUsing;
  49.     procedure CMHelpAbout(var Msg: TMessage);
  50.       virtual cm_First + cm_HelpAbout;
  51.     procedure WMLButtonDown(var Msg: TMessage);
  52.       virtual wm_First + wm_LButtonDown;
  53.     procedure WMCommand(var Msg: TMessage);
  54.       virtual wm_First + wm_Command;
  55.     procedure WMSize(var Msg: TMessage);
  56.       virtual wm_First + wm_Size;
  57.     procedure WMEnterIdle(var Msg: TMessage);
  58.       virtual wm_First + wm_EnterIdle;
  59.     procedure WMDestroy(var Msg: TMessage);
  60.       virtual wm_First + wm_Destroy;
  61.   end;
  62.  
  63.  
  64. implementation
  65.  
  66.  
  67. {- Toggle a checkmarked menu item on or off }
  68.  
  69. procedure ToggleCheck(Menu: HMenu; MenuItemID: Word);
  70. var
  71.   MAttr, WCheck: Word;
  72. begin
  73.   MAttr := GetMenuState(Menu, MenuItemID, mf_ByCommand);
  74.   if (MAttr and mf_Checked) = mf_Checked then
  75.     WCheck := mf_ByCommand or mf_Unchecked
  76.   else
  77.     WCheck := mf_ByCommand or mf_Checked;
  78.   CheckMenuItem(Menu, MenuItemID, WCheck);
  79. end;
  80.  
  81.  
  82. {- Construct Mancala window object }
  83.  
  84. constructor TMancalaWin.Init(AParent: PWindowsObject; ATitle: PChar);
  85. const
  86.   ExeNameMaxSize = 128;
  87. var
  88.   FileNameLen: Integer;
  89.   FileName: array[0 .. ExeNameMaxSize + 1] of Char;
  90.   I: Integer;
  91. begin
  92.   TWindow.Init(AParent, ATitle);
  93.   with Attr do
  94.   begin
  95.     X := XCenter - XMax div 2;
  96.     Y := YCenter - YMax div 2;
  97.     W := XMax;
  98.     H := YMax;
  99.     Style := ws_Caption + ws_SysMenu + ws_MinimizeBox + ws_MaximizeBox;
  100.     Menu := LoadMenu(HInstance, PChar(id_Menu));
  101.     ToggleCheck(Menu, (cm_EditLevel1 + MaxPly) - 1);
  102.   end;
  103.   BkPattern := CreateSolidBrush(CBackground);
  104.   InitUGraphics;
  105.   {- Construct HelpFileName from Module Name }
  106.   FileNameLen := GetModuleFileName(HInstance, FileName, ExeNameMaxSize);
  107.   I := FileNameLen - 1;
  108.   while (I <> 0) and ((FileName[I] <> '\') and (FileName[I] <> ':')) do
  109.     Dec(I);
  110.   Inc(I);
  111.   if I + 13 <= ExeNameMaxSize then
  112.     StrCopy(@FileName[I], 'mancala.hlp')
  113.   else
  114.     StrCopy(@FileName[I], '?');
  115.   HelpFileName := StrNew(FileName);
  116.   Help := false;
  117. end;
  118.  
  119.  
  120. {- Destroy TMancalaWin window and the custom background pattern }
  121.  
  122. destructor TMancalaWin.Done;
  123. begin
  124.   DeleteObject(BkPattern);
  125.   DeleteObject(FlashBits);
  126.   StrDispose(HelpFileName);
  127.   TWindow.Done;
  128. end;
  129.  
  130.  
  131. {- Perform initializations for which window handle is needed }
  132.  
  133. procedure TMancalaWin.SetupWindow;
  134. begin
  135.   TWindow.SetupWindow;
  136.   NewGame(Side);
  137. end;
  138.  
  139.  
  140. {- Return name for new window class }
  141.  
  142. function TMancalaWin.GetClassName: PChar;
  143. begin
  144.   GetClassName := 'MancalaWin';
  145. end;
  146.  
  147.  
  148. {- Modify window class to use custom icon }
  149.  
  150. procedure TMancalaWin.GetWindowClass(var AWndClass: TWndClass);
  151. begin
  152.   TWindow.GetWindowClass(AWndClass);
  153.   AWndClass.HIcon := LoadIcon(HInstance, PChar(id_Icon));
  154.   AWndClass.HBrBackground := BkPattern;
  155. end;
  156.  
  157.  
  158. {- Display program's icon in window }
  159.  
  160. procedure TMancalaWin.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  161. begin
  162.   DrawGameboard(PaintDC, MainPosition.Gameboard);
  163. end;
  164.  
  165.  
  166. {- Return true if it's okay to close window (i.e. to end the program) }
  167.  
  168. function TMancalaWin.CanClose: Boolean;
  169. begin
  170.   CanClose := MessageBox(HWindow, 'End Mancala now?', 'Please answer',
  171.     mb_YesNo or mb_IconQuestion) = id_Yes
  172. end;
  173.  
  174.  
  175. {- Make human and computer moves. }
  176.  
  177. procedure TMancalaWin.MakeMoves;
  178. var
  179.   NextMove: OneMove;              { Result from GetMove }
  180.   Score: Integer;                 { Unused, returned by MakeMove }
  181.   DC: HDC;                        { Display context for visuals }
  182. begin
  183.   DC := GetDC(HWindow);
  184.   if not MainPosition.Win then
  185.   if GetMove(Side, NextMove) then
  186.   begin
  187.     PrepareReplay(NextMove);
  188.     EnableMenuItem(Attr.Menu, cm_ActionReplay, mf_Enabled or mf_ByCommand);
  189.     MakeGraphMove(DC, MainPosition, Side, NextMove); { Visual }
  190.     MakeMove(MainPosition, Side, NextMove, Score);   { Logical }
  191.     with MainPosition do
  192.     begin
  193.       if Win then
  194.       begin
  195.         EnableMenuItem(Attr.Menu, cm_ActionPass, mf_Grayed or mf_ByCommand);
  196.         EnableMenuItem(Attr.Menu, cm_ActionSwitch, mf_Grayed or mf_ByCommand);
  197.         if WinningSide = computer then
  198.           DisplayMessage(DC, I_win)
  199.         else
  200.           DisplayMessage(DC, You_win);
  201.       end else
  202.       if not GoAgain then
  203.       begin
  204.         if Side = computer then
  205.         begin
  206.           Side := human;
  207.           DisplayMessage(DC, Its_your_move);
  208.         end else
  209.         begin
  210.           Side := computer;
  211.           DisplayMessage(DC, Its_my_move);
  212.         end
  213.       end else
  214.       begin
  215.         if Side = computer then
  216.           DisplayMessage(DC, I_go_again)
  217.         else
  218.           DisplayMessage(DC, You_go_again)
  219.       end;
  220.     end;
  221.   end;
  222.   ReleaseDC(HWindow, DC);
  223. end;
  224.  
  225.  
  226. {- Begin a new game }
  227.  
  228. procedure TMancalaWin.CMGameNew(var Msg: TMessage);
  229. begin
  230.   if MessageBox(HWindow, 'Start a new game?', 'Please answer',
  231.     mb_YesNo or mb_IconQuestion) = id_Yes then
  232.   begin
  233.     NewGame(Side);
  234.     EnableMenuitem(Attr.Menu, cm_ActionReplay, mf_Grayed or mf_ByCommand);
  235.     EnableMenuItem(Attr.Menu, cm_ActionPass, mf_Enabled or mf_ByCommand);
  236.     EnableMenuItem(Attr.Menu, cm_ActionSwitch, mf_Enabled or mf_ByCommand);
  237.   end;
  238. end;
  239.  
  240.  
  241. {- Quit program }
  242.  
  243. procedure TMancalaWin.CMGameExit(var Msg: TMessage);
  244. begin
  245.   CloseWindow;
  246. end;
  247.  
  248.  
  249. {- Select program options }
  250.  
  251. procedure TMancalaWin.CMEditOptions(var Msg: TMessage);
  252. var
  253.   Dialog: OptDialog;
  254.   Options: OptionsRec;
  255.   S: String[2];
  256.   N, ErrorCode: Integer;
  257. begin
  258.   Str(PebblesPerCup, S);
  259.   StrPCopy(Options.PPCLine, S);
  260.   Dialog.Init(@Self, PChar(id_Options), @Options);
  261.   if Dialog.Execute = id_Ok then
  262.   begin
  263.     Val(Options.PPCLine, N, ErrorCode);
  264.     if ErrorCode = 0 then
  265.       PebblesPerCup := N;
  266.     if (PebblesPerCup < 1) or (PebblesPerCup > 9) then
  267.       PebblesPerCup := 3
  268.   end;
  269.   Dialog.Done;
  270. end;
  271.  
  272.  
  273. {- Execute instant replay feature }
  274.  
  275. procedure TMancalaWin.CMActionReplay(var Msg: TMessage);
  276. var
  277.   Score: Integer;                 { Returned by MakeMove (ignored) }
  278.   OldMessage: Integer;            { Saved message number }
  279.   DC: HDC;
  280. begin
  281.   if ReplayOk then
  282.   begin
  283.     MainPosition := ReplayBoard;
  284.     OldMessage := CurrentMessage;
  285.     CurrentMessage := Instant_Replay;
  286.     DC := GetDC(HWindow);
  287.     DrawGameboard(DC, MainPosition.Gameboard);
  288.     MakeGraphMove(DC, MainPosition, ReplaySide, ReplayMove);
  289.     MakeMove(MainPosition, ReplaySide, ReplayMove, Score);
  290.     DisplayMessage(DC, OldMessage);
  291.     ReleaseDC(HWindow, DC);
  292.   end;
  293. end;
  294.  
  295.  
  296. {- Pass turn (used to let computer go first or next }
  297.  
  298. procedure TMancalaWin.CMActionPass(var Msg: TMessage);
  299. var
  300.   DC: HDC;
  301. begin
  302.   if MessageBox(HWindow, 'Let computer move next?', 'Please answer',
  303.     mb_YesNo or mb_IconQuestion) = id_Yes then
  304.   begin
  305.     Side := Computer;
  306.     DC := GetDC(HWindow);
  307.     DisplayMessage(DC, Its_my_move);
  308.     ReleaseDC(HWindow, DC);
  309.     while (not MainPosition.Win) and (Side = computer) do
  310.       MakeMoves;
  311.   end;
  312. end;
  313.  
  314.  
  315. {- Play with the other side's pieces }
  316.  
  317. procedure TMancalaWin.CMActionSwitch(var Msg: TMessage);
  318. var
  319.   NewBoard: Board;
  320.   CompCup, HumanCup: CupIndex;
  321. begin
  322.   with MainPosition do
  323.   begin
  324.     NewBoard[HumanKalah] := Gameboard[CompKalah];
  325.     NewBoard[CompKalah] := Gameboard[HumanKalah];
  326.     CompCup := compFirstCup;
  327.     for HumanCup := humanFirstCup to humanLastCup do
  328.     begin
  329.       NewBoard[HumanCup] := Gameboard[CompCup];
  330.       NewBoard[CompCup] := Gameboard[HumanCup];
  331.       Inc(CompCup);
  332.     end;
  333.     Gameboard := NewBoard;
  334.   end;
  335.   InvalidateRect(HWindow, nil, true);
  336. end;
  337.  
  338.  
  339. {- Display Windows Help index }
  340.  
  341. procedure TMancalaWin.CMHelpIndex(var Msg: TMessage);
  342. begin
  343.   WinHelp(HWindow, HelpFileName, Help_Index, 0);
  344. end;
  345.  
  346.  
  347. {- Display Windows Help on Help }
  348.  
  349. procedure TMancalaWin.CMHelpUsing(var Msg: TMessage);
  350. begin
  351.   WinHelp(HWindow, 'WINHELP.HLP', Help_Index, 0);
  352. end;
  353.  
  354.  
  355. {- Display About box dialog }
  356.  
  357. procedure TMancalaWin.CMHelpAbout(var Msg: TMessage);
  358. var
  359.   Dialog: TDialog;
  360. begin
  361.   Dialog.Init(@Self, PChar(id_About));
  362.   Dialog.Execute;
  363.   Dialog.Done;
  364. end;
  365.  
  366.  
  367. {- Respond to left-button click. Make move if inside cup }
  368.  
  369. procedure TMancalaWin.WMLButtonDown(var Msg: TMessage);
  370. var
  371.   P: TPoint;
  372.   R: TRect;
  373.   CupNum: CupIndex;
  374. begin
  375.   with Msg do
  376.   begin
  377.     P.X := LParamLo;
  378.     P.Y := LParamHi;
  379.     for CupNum := 0 to maxCupIndex do
  380.     begin
  381.       with CupCoords[CupNum] do
  382.         SetRect(R, X, Y + 15, X + 52, Y + 52);
  383.       if PtInRect(R, P) then
  384.       if (HumanFirstCup <= CupNum) and (CupNum <= HumanLastCup) then
  385.         HumanMove := CupNum
  386.     end;
  387.   end;
  388.   if HumanMove >= 0 then
  389.   begin
  390.     MakeMoves;                    { Make human's move }
  391.     while (not MainPosition.Win) and (Side = computer) do
  392.       MakeMoves;                  { Make computer's response(s) }
  393.   end;
  394. end;
  395.  
  396.  
  397. {- Intercept all wm_Command (Options:Leveln) command messages }
  398.  
  399. procedure TMancalaWin.WMCommand(var Msg: TMessage);
  400. var
  401.   CupNum: Integer;
  402.   Location: LongInt;
  403.   HelpContextId: LongInt;
  404.  
  405.   {- Local to WMCommand: Display help rather than execute a command }
  406.   procedure DisplayHelp;
  407.   begin
  408.     case Msg.WParam of
  409.       cm_GameNew: HelpContextId := hc_command_new;
  410.       cm_GameExit: HelpContextId := hc_command_exit;
  411.       cm_EditOptions: HelpContextId := hc_command_options;
  412.       cm_EditLevel1 .. cm_EditLevel7: HelpContextId := hc_command_level;
  413.       cm_ActionReplay: HelpContextId := hc_command_replay;
  414.       cm_ActionPass: HelpContextId := hc_command_pass;
  415.       cm_ActionSwitch: HelpContextId := hc_command_switch;
  416.       cm_HelpIndex: HelpContextId := hc_command_index;
  417.       cm_HelpUsing: HelpContextId := hc_command_using_help;
  418.       cm_HelpAbout: HelpContextId := hc_command_about;
  419.     else
  420.       HelpContextId := 0;
  421.     end;
  422.     if HelpContextId <> 0 then
  423.       WinHelp(HWindow, HelpFileName, Help_Context, HelpContextId)
  424.     else begin
  425.       MessageBox(HWindow, 'Help not available for item', 'Message', mb_Ok);
  426.       DefWndProc(Msg);
  427.     end;
  428.     Help := false;
  429.   end;
  430.  
  431. begin
  432.   if Help then DisplayHelp else
  433.   begin
  434.     case Msg.WParam of
  435.       cm_EditLevel1 .. cm_EditLevel7:
  436.       begin {- Select difficulty level (i.e. search "ply") }
  437.         ToggleCheck(Attr.Menu, (cm_EditLevel1 + MaxPly) - 1);
  438.         MaxPly := (Msg.WParam - cm_EditLevel1) + 1;
  439.         ToggleCheck(Attr.Menu, (cm_EditLevel1 + MaxPly) - 1);
  440.       end;
  441.       cm_Move1 .. cm_Move6:   { cm_Move7 .. cm_Move 9 ignored in this version }
  442.       begin {- Simulate mouse click for keyboard control }
  443.         CupNum := humanFirstCup + (Msg.WParam - cm_Move1);
  444.         with CupCoords[CupNum] do
  445.           Location := MAKELONG(X, Y + 20);
  446.         PostMessage(HWindow, wm_LButtonDown, 0, Location);
  447.         PostMessage(HWindow, wm_LButtonUp, 0, Location);
  448.       end;
  449.     else
  450.       TWindow.WMCommand(Msg)
  451.     end;
  452.   end;
  453. end;
  454.  
  455.  
  456. {- Recalculate postions when window size changes }
  457.  
  458. procedure TMancalaWin.WMSize(var Msg: TMessage);
  459. var
  460.   R: TRect;
  461. begin
  462.   GetClientRect(HWindow, R);
  463.   XMax := R.Right;
  464.   if XMax < 524 then XMax := 524;
  465.   YMax := R.Bottom;
  466.   if YMax < 360 + GetSystemMetrics(sm_CYMenu) then
  467.     YMax := 360 + GetSystemMetrics(sm_CYMenu);
  468.   XCenter := GetSystemMetrics(sm_CXScreen) div 2;
  469.   YCenter := GetSystemMetrics(sm_CYScreen) div 2;
  470.   XBase := (XMax - 472) div 2;
  471.   YBase := (YMax div 2) - 64;
  472.   InitUGraphics;  { Reinitialize various graphics-item positions }
  473. end;
  474.  
  475.  
  476. {- Select Help when F1 pressed and a menu item is highlighted }
  477.  
  478. procedure TMancalaWin.WMEnterIdle(var Msg: TMessage);
  479. begin
  480.   if (Msg.WParam = msgf_Menu) and
  481.      ((GetKeyState(vk_F1) and $8000) = $8000) then
  482.   begin
  483.     Help := true;  { Causes help to be displayed rather than execute a command }
  484.     PostMessage(HWindow, wm_KeyDown, vk_Return, 0);  { Simulate Enter keypress }
  485.   end;
  486. end;
  487.  
  488.  
  489. {- Tell help system to close its window if open }
  490.  
  491. procedure TMancalaWin.WMDestroy(var Msg: TMessage);
  492. begin
  493.   WinHelp(HWindow, HelpFileName, help_Quit, 0);
  494.   TWindow.WMDestroy(Msg);
  495. end;
  496.  
  497.  
  498.  
  499. end.
  500.  
  501.  
  502. { ----------------------------------------------------------------
  503.   Copyright (c) 1991 by Swan Software. All rights reserved.
  504.   Revision 1.00    Date: 8/21/1991
  505.   ---------------------------------------------------------------- }
  506.